home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MOUSE.SWG / 0016_Basic Mouse Routines.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  4KB  |  179 lines
  1. {
  2. From: BERNIE PALLEK
  3. Subj: Mouse routines
  4. ---------------------------------------------------------------------------
  5. >I'm after a good mouse unit for Turbo Pascal 7.
  6.  
  7. OK, here it is:
  8. }
  9. {$R-,S-}
  10.  
  11. UNIT BMouse;  { basic mouse routines }
  12.  
  13.  
  14. INTERFACE
  15.  
  16.  
  17. TYPE
  18.   CustomMouseCursor = ARRAY[0..31] OF Word;
  19.  
  20. CONST
  21.   { button masks }
  22.   Left_B    = $0001;
  23.   Right_B   = $0002;
  24.   Center_B  = $0004;
  25.   { text pointer selectors }
  26.   Software_Pointer = 0;
  27.   Hardware_Pointer = 1;
  28.  
  29. FUNCTION  Ms_Init(VAR numOfButtons : Word) : Boolean;
  30. PROCEDURE Ms_SetHLimits(xmin, xmax : Word);
  31. PROCEDURE Ms_SetVLimits(ymin, ymax : Word);
  32. PROCEDURE Ms_Show;
  33. PROCEDURE Ms_Hide;
  34. PROCEDURE Ms_Read(VAR x, y, b_mask : Word);
  35. PROCEDURE Ms_SetPos(x, y : Word);
  36. PROCEDURE Ms_SetGraphPointer(newShape : CustomMouseCursor; hot_x, hot_y :
  37. Word);
  38. PROCEDURE Ms_SetTextPointer(select : Word; scr_char : Char; scr_attr : Byte;
  39.                             ptr_char : Char; ptr_attr : Byte);
  40. PROCEDURE Ms_SetMPP(hMPP, vMPP : Word);
  41. PROCEDURE Ms_ReadPosFromLast(VAR hCount, vCount : Word);
  42.  
  43.  
  44. IMPLEMENTATION
  45.  
  46.  
  47. USES Dos;
  48.  
  49. VAR
  50.   mouse_detected : Boolean;
  51.   r              : Registers; { scratch Registers variable }
  52.   mi             : Pointer;   { mouse interrupt vector for initial test }
  53.  
  54.  
  55. FUNCTION Ms_Init(VAR numOfButtons : Word) : Boolean;
  56. BEGIN
  57.   IF mouse_detected THEN BEGIN
  58.     r.AX := 0;
  59.     Intr($33, r);
  60.     IF (r.AX = 0) THEN BEGIN
  61.       numOfButtons := 0;
  62.       Ms_Init := False;
  63.     END ELSE BEGIN
  64.        numOfButtons := r.BX;
  65.        Ms_Init := True;
  66.     END;
  67.   END ELSE BEGIN
  68.     numOfButtons := 0;
  69.     Ms_Init := False;
  70.   END;
  71. END;
  72.  
  73. PROCEDURE Ms_SetHLimits(xmin, xmax : Word);
  74. BEGIN
  75.   r.AX := 7;  { set horizontal limits }
  76.   r.CX := xmin;
  77.   r.DX := xmax;
  78.   Intr($33, r);
  79. END;
  80.  
  81. PROCEDURE Ms_SetVLimits(ymin, ymax : Word);
  82. BEGIN
  83.   r.AX := 8;  { set vertical limits }
  84.   r.CX := ymin;
  85.   r.DX := ymax;
  86.   Intr($33, r);
  87. END;
  88.  
  89. PROCEDURE Ms_Show;
  90. BEGIN
  91.   r.AX := 1;
  92.   Intr($33, r);
  93. END;
  94.  
  95. PROCEDURE Ms_Hide;
  96. BEGIN
  97.   r.AX := 2;
  98.   Intr($33, r);
  99. END;
  100.  
  101. PROCEDURE Ms_Read(VAR x, y, b_mask : Word);
  102. BEGIN
  103.   r.AX := 3;
  104.   Intr($33, r);
  105.   x := r.CX;
  106.   y := r.DX;
  107.   b_mask := r.BX;
  108. END;
  109.  
  110. PROCEDURE Ms_SetPos(x, y : Word);
  111. BEGIN
  112.   r.AX := 4;
  113.   r.CX := x;
  114.   r.DX := y;
  115.   Intr($33, r);
  116. END;
  117.  
  118. PROCEDURE Ms_SetGraphPointer(newShape : CustomMouseCursor; hot_x, hot_y :
  119. Word);
  120. BEGIN
  121.   r.AX := 9;
  122.   r.BX := hot_x;
  123.   r.CX := hot_y;
  124.   r.DX := Ofs(newShape);
  125.   r.ES := Seg(newShape);
  126.   Intr($33, r);
  127. END;
  128.  
  129. PROCEDURE Ms_SetTextPointer(select : Word; scr_char : Char; scr_attr : Byte;
  130.                             ptr_char : Char; ptr_attr : Byte);
  131. BEGIN
  132.   r.AX := 10;
  133.   r.BX := select;  { determines which pointer: software or hardware }
  134.   r.CL := Byte(scr_char);
  135.   r.CH := scr_attr;
  136.   r.DL := Byte(ptr_char);
  137.   r.DH := ptr_attr;
  138.   Intr($33, r);
  139. END;
  140.  
  141. PROCEDURE Ms_SetMPP(hMPP, vMPP : Word);  { Set [M]ickeys [P]er [P]ixel }
  142. {  set horizontal and vertical mouse motion rates }
  143. {  MPP (1 <= MPP <= 32767) = Mickeys / 8 pixels   }
  144. {  default hMPP is 8:8                            }
  145. {  default vMPP is 16:8                           }
  146. BEGIN
  147.   IF (hMPP >= 1) AND (hMPP <= 32767) AND (vMPP >= 1) AND (vMPP <= 32767) THEN
  148. BEGIN
  149.     r.AX := 15;
  150.     r.CX := hMPP;
  151.     r.DX := vMPP;
  152.     Intr($33, r);
  153.   END;
  154. END;
  155.  
  156. PROCEDURE Ms_ReadPosFromLast(VAR hCount, vCount : Word);
  157. { Return the number of Mickeys the mouse has moved since the }
  158. { last call to this function.                                }
  159. { A positive number is right/down.                           }
  160. BEGIN
  161.   r.AX := 11;
  162.   Intr($33, r);
  163.   hCount := r.CX;
  164.   vCount := r.DX;
  165. END;
  166.  
  167.  
  168. {=== UNIT INITIALIZATION ========================================}
  169. BEGIN
  170.   GetIntVec($33, mi);
  171.   IF (mi = NIL) THEN
  172.     mouse_detected := False
  173.   ELSE
  174.     IF (Byte(mi^) = $CF) THEN mouse_detected := False
  175.   ELSE
  176.     mouse_detected := True;
  177. END.
  178.  
  179.